home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue65 / construc / twmlprod.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-12-05  |  3.1 KB  |  133 lines
  1. unit twmlprod;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   HTTPApp, DB, DBWeb;
  6.  
  7. type
  8.   TWMLDataSetTableProducer = class(TDataSetTableProducer)
  9.   public
  10.     function TableHeader: string; override;
  11.     function Content: string; override;
  12.   end;
  13.  
  14. procedure Register;
  15.  
  16. implementation
  17. const
  18.   StartRow = '<tr>';
  19.   EndRow = '</tr>';
  20.  
  21. function EnCode(Str: String): String;
  22. { Convert memo contents to single line XML }
  23. var
  24.   i: Integer;
  25. begin
  26.   for i:=Length(Str) downto 1 do
  27.   begin
  28.     case Str[i] of
  29.     '"': begin
  30.            Insert('"',Str,i+1);
  31.            Delete(Str,i,1)
  32.          end;
  33.    '''': begin
  34.            Insert(''',Str,i+1);
  35.            Delete(Str,i,1)
  36.          end;
  37.     '&': begin
  38.            Insert('&',Str,i+1);
  39.            Delete(Str,i,1)
  40.          end;
  41.     '<': begin
  42.            Insert('<',Str,i+1);
  43.            Delete(Str,i,1)
  44.          end;
  45.     '>': begin
  46.            Insert('>',Str,i+1);
  47.            Delete(Str,i,1)
  48.          end;
  49.     '-': begin
  50.            Insert('­',Str,i+1);
  51.            Delete(Str,i,1)
  52.          end;
  53.     else
  54.       if (Ord(Str[i]) in [1..31]) then
  55.       begin
  56.         Insert('&#'+IntToStr(Ord(Str[i]))+';',Str,i+1);
  57.         Delete(Str,i,1)
  58.       end
  59.       else
  60.         if Str[i] = #0 then Delete(Str,i,1)
  61.     end
  62.   end;
  63.   Result := Str
  64. end {EnCode};
  65.  
  66. function WMLTable(DataSet: TDataSet; DataSetHandler: TWMLDataSetTableProducer;
  67.   MaxRows: Integer): string;
  68. var
  69.   I, J: Integer;
  70.   DisplayText: string;
  71.   Field: TField;
  72.   Column: THTMLTableColumn;
  73. begin
  74.   Result := DataSetHandler.TableHeader + #13#10;
  75.   if DataSet.State = dsBrowse then
  76.   begin
  77.     J := 1;
  78.     while (MaxRows <> 0) and not DataSet.EOF do
  79.     begin
  80.       Result := Result + StartRow;
  81.       for I := 0 to DataSetHandler.Columns.Count - 1 do
  82.       begin
  83.         Column := DataSetHandler.Columns[I];
  84.         Field := Column.Field;
  85.         if Field <> nil then
  86.           DisplayText := EnCode(Field.DisplayText)
  87.         else DisplayText := '';
  88.         with Column do
  89.           Result := Result + DataSetHandler.FormatCell(J, I, DisplayText,
  90.             'td', '', Align, VAlign, '');
  91.       end;
  92.       Result := Result + EndRow + #13#10;
  93.       DataSet.Next;
  94.       Dec(MaxRows);
  95.       Inc(J);
  96.     end;
  97.   end;
  98.   Result := Result + '</table>';
  99. end;
  100.  
  101. { TWMLDataSetTableProducer }
  102.  
  103. function TWMLDataSetTableProducer.Content: string;
  104. begin
  105.   Result := '';
  106.   if DataSet <> nil then
  107.   begin
  108.     if DataSet.Active and (Columns.Count = 0) then LayoutChanged;
  109.     if DoCreateContent then
  110.       Result := Header.Text + WMLTable(DataSet, Self, MaxRows) + Footer.Text;
  111.   end;
  112. end;
  113.  
  114. function TWMLDataSetTableProducer.TableHeader: string;
  115. begin
  116.   Result := '<table';
  117.   with TableAttributes do
  118.   begin
  119.     if Width > 0 then
  120.       Result := Format('%s columns="%d"', [Result, Columns.Count]);
  121.     if Custom <> '' then
  122.       Result := Format('%s %s', [Result, Custom]);
  123.   end;
  124.   Result := Result + '>';
  125. end;
  126.  
  127. procedure Register;
  128. begin
  129.   RegisterComponents('DrBob42', [TWMLDataSetTableProducer]);
  130. end;
  131.  
  132. end.
  133.